home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / GFXFX2.ZIP / 3D_13H.PAS next >
Encoding:
Pascal/Delphi Source File  |  1995-02-14  |  7.8 KB  |  209 lines
  1.  
  2. program mode_13h_3d; { 3D_13H.PAS }
  3. { mode-13h version of polygoned objects, by Bas van Gaalen,
  4.   might be slow on some (or actualy most) computers }
  5. uses u_vga,u_pal,u_3d,u_kb;
  6.  
  7. {$define deca} { deca, cube, l4a, loes, bar, tri, bas, check, sven }
  8.  
  9. const
  10. {$ifdef deca}
  11.   fpoly=1; { first poly to draw from }
  12.   nofpoints=12; { number of points }
  13.   nofplanes=8; { number of planes }
  14.   points:array[1..nofpoints,0..2] of integer=(
  15.     (-20,-20, 30),( 20,-20, 30),( 40,-40,  0),( 20,-20,-30),
  16.     (-20,-20,-30),(-40,-40,  0),(-20, 20, 30),( 20, 20, 30),
  17.     ( 40, 40,  0),( 20, 20,-30),(-20, 20,-30),(-40, 40,  0));
  18.   planes:array[1..nofplanes,0..3] of byte=(
  19.     (2,3,9,8),(10,9,3,4),(11,5,6,12),(7,12,6,1),
  20.     (1,2,3,6),(6,3,4,5),(7,8,9,12),(12,9,10,11));
  21. {$endif}
  22.  
  23. {$ifdef cube}
  24.   fpoly=4;
  25.   nofpoints=8;
  26.   nofplanes=6;
  27.   points:array[1..nofpoints,0..2] of integer=(
  28.     (-30,-30,-30),(-30,-30,30),(30,-30,30),(30,-30,-30),
  29.     (-30, 30,-30),(-30, 30,30),(30, 30,30),(30, 30,-30));
  30.   planes:array[1..nofplanes,0..3] of byte=(
  31.     (1,5,6,2),(1,4,8,5),(1,2,3,4),(5,6,7,8),(8,7,3,4),(2,3,7,6));
  32. {$endif}
  33.  
  34. {$ifdef l4a}
  35.   { Guess to who this is dedicated... }
  36.   fpoly=1;
  37.   nofpoints=28;
  38.   nofplanes=9;
  39.   points:array[1..nofpoints,0..2] of integer=(
  40. {l} (-50,-25,  0),(-20,-25,  0),(-20,-15,  0),(-40,-15,  0),
  41.     (-40, 25,  0),(-50, 25,  0),
  42. {4} (-10,-25,  0),(  0,-25,  0),(  0, 25,  0),(-10, 25,  0),
  43.     ( -8,  5,  0),(-20,  5,  0),(-20, 25,  0),(-30, 25,  0),
  44.     (-30, -5,  0),( -8, -5,  0),
  45. {a} ( 10,-25,  0),( 20,-25,  0),( 18, -5,  0),( 32, -5,  0),
  46.     ( 30,-25,  0),( 40,-25,  0),( 40, 25,  0),( 10, 25,  0),
  47.     ( 18,  5,  0),( 32,  5,  0),( 30, 15,  0),( 20, 15,  0));
  48.   planes:array[1..nofplanes,0..3] of byte=(
  49. {l} (1,2,3,4),(1,4,5,6),
  50. {4} (7,8,9,10),(15,16,11,12),(15,12,13,14),
  51. {a} (17,18,28,24),(28,27,23,24),(21,22,23,27),(19,20,26,25));
  52. {$endif}
  53.  
  54. {$ifdef loes}
  55.   fpoly=1;
  56.   nofpoints=38;
  57.   nofplanes=15;
  58.   points:array[1..nofpoints,0..2] of integer=(
  59. {l} (-70,-25,-15),(-40,-25,-15),(-40,-15,-15),(-60,-15,-15),(-60,25,-15),(-70,25,-15),
  60. {o} (-35,-25,-5),(-5,-25,-5),(-5,25,-5),(-35,25,-5),(-25,-15,-5),(-15,-15,-5),
  61.     (-15,15,-5),(-25,15,-5),
  62. {e} (0,-25,5),(30,-25,5),(30,-15,5),(10,-15,5),(8,-5,5),(20,-5,5),
  63.     (20,5,5),(8,5,5),(10,15,5),(30,15,5),(30,25,5),(0,25,5),
  64. {s} (35,-25,15),(65,-25,15),(65,5,15),(45,5,15),(45,15,15),(65,15,15),(65,25,15),
  65.     (35,25,15),(35,-5,15),(55,-5,15),(55,-15,15),(35,-15,15));
  66.   planes:array[1..nofplanes,0..3] of byte=(
  67. {l} (1,2,3,4),(1,4,5,6),
  68. {o} (7,8,12,11),(8,9,13,12),(14,13,9,10),(7,11,14,10),
  69. {e} (15,16,17,18),(15,18,23,26),(19,20,21,22),(23,24,25,26),
  70. {s} (27,28,37,38),(28,29,36,37),(35,36,29,30),(35,30,31,34),(31,32,33,34));
  71. {$endif}
  72.  
  73. {$ifdef bar}
  74.   fpoly=3;
  75.   nofpoints=8;
  76.   nofplanes=6;
  77.   points:array[1..nofpoints,0..2] of integer=(
  78.     (-20,-40, 20),( 20,-40, 20),( 20,-40,-20),(-20,-40,-20),
  79.     (-20, 40, 20),( 20, 40, 20),( 20, 40,-20),(-20, 40,-20));
  80.   planes:array[1..nofplanes,0..3] of byte=(
  81.     (1,5,6,2),(1,4,8,5),(1,2,3,4),(5,6,7,8),(8,7,3,4),(2,3,7,6));
  82. {$endif}
  83.  
  84. {$ifdef tri}
  85.   fpoly=2;
  86.   nofpoints=8;
  87.   nofplanes=6;
  88.   points:array[1..nofpoints,0..2] of integer=(
  89.     (-40,-40,-20),(-10,-10, 20),( 10,-10, 20),( 40,-40,-20),
  90.     (-40, 40,-20),(-10, 10, 20),( 10, 10, 20),( 40, 40,-20));
  91.   planes:array[1..nofplanes,0..3] of byte=(
  92.     (1,5,6,2),(1,4,8,5),(1,2,3,4),(5,6,7,8),(8,7,3,4),(2,3,7,6));
  93. {$endif}
  94.  
  95. {$ifdef bas}
  96.   fpoly=1;
  97.   nofpoints=40;
  98.   nofplanes=16;
  99.   points:array[1..nofpoints,0..2] of integer=(
  100. {b} (-55,-25,  0),(-30,-25,  0),(-25,-20,  0),(-25, -5,  0),
  101.     (-30,  0,  0),(-25,  5,  0),(-25, 20,  0),(-30, 25,  0),
  102.     (-55, 25,  0),(-45,-15,  0),(-35,-15,  0),(-35, -5,  0),
  103.     (-47, -5,  0),(-47,  5,  0),(-35,  5,  0),(-35, 15,  0),
  104.     (-45, 15,  0),
  105. {a} (-15,-25,  0),( -5,-25,  0),( -5,-15,  0),(  5,-15,  0),
  106.     (  5,-25,  0),( 15,-25,  0),(  5, 25,  0),( -5, 25,  0),
  107.     ( -5, -5,  0),(  5, -5,  0),(  0, 15,  0),
  108. {s} ( 25,-25,  0),( 55,-25,  0),( 55,  5,  0),( 35,  5,  0),
  109.     ( 35, 15,  0),( 55, 15,  0),( 55, 25,  0),( 25, 25,  0),
  110.     ( 25, -5,  0),( 45, -5,  0),( 45,-15,  0),( 25,-15,  0));
  111.   planes:array[1..nofplanes,0..3] of byte=(
  112. {b} (1,2,11,10),(2,3,4,11),(4,5,12,11),(12,6,7,15),(15,7,8,16),
  113.     (16,8,9,17),(1,10,17,9),(13,12,15,14),
  114. {a} (18,19,24,25),(22,23,24,28),(20,21,27,26),
  115. {s} (29,30,39,40),(30,31,38,39),(31,32,37,38),(32,33,36,37),
  116.     (33,34,35,36));
  117. {$endif}
  118.  
  119. {$ifdef check}
  120.   fpoly=1;
  121.   nofpoints=36;
  122.   nofplanes=13;
  123.   points:array[1..nofpoints,0..2] of integer=(
  124.   (-50,-50,20),(-30,-50,20),(-10,-50,20),(10,-50,20),(30,-50,20),(50,-50,20),
  125.   (-50,-30,20),(-30,-30,20),(-10,-30,20),(10,-30,20),(30,-30,20),(50,-30,20),
  126.   (-50,-10,20),(-30,-10,20),(-10,-10,20),(10,-10,20),(30,-10,20),(50,-10,20),
  127.   (-50,10,20),(-30,10,20),(-10,10,20),(10,10,20),(30,10,20),(50,10,20),
  128.   (-50,30,20),(-30,30,20),(-10,30,20),(10,30,20),(30,30,20),(50,30,20),
  129.   (-50,50,20),(-30,50,20),(-10,50,20),(10,50,20),(30,50,20),(50,50,20));
  130.   planes:array[1..nofplanes,0..3] of byte=(
  131.   (1,2,8,7),(3,4,10,9),(5,6,12,11),(8,9,15,14),(10,11,17,16),
  132.   (13,14,20,19),(15,16,22,21),(17,18,24,23),(20,21,27,26),
  133.   (22,23,29,28),(25,26,32,31),(27,28,34,33),(29,30,36,35));
  134. {$endif}
  135.  
  136. {$ifdef sven}
  137.   fpoly=1;
  138.   nofpoints=41;
  139.   nofplanes=14;
  140.   points:array[1..nofpoints,0..2] of integer=(
  141. {s} (-75,-25,  0),(-45,-25,  0),(-45,  5,  0),(-65,  5,  0),
  142.     (-65, 15,  0),(-45, 15,  0),(-45, 25,  0),(-75, 25,  0),
  143.     (-75, -5,  0),(-55, -5,  0),(-55,-15,  0),(-75,-15,  0),
  144. {v} (-25,-25,  0),(-15,-25,  0),( -5, 25,  0),(-15, 25,  0),
  145.     (-20,-15,  0),(-25, 25,  0),(-35, 25,  0),
  146. {e} (  5,-25,  0),( 35,-25,  0),( 35,-15,  0),( 15,-15,  0),
  147.     ( 15, -5,  0),( 25, -5,  0),( 25,  5,  0),( 15,  5,  0),
  148.     ( 15, 15,  0),( 35, 15,  0),( 35, 25,  0),(  5, 25,  0),
  149. {n} ( 45,-25,  0),( 55,-25,  0),( 55, 15,  0),( 65,-25,  0),
  150.     ( 75,-25,  0),( 75, 25,  0),( 65, 25,  0),( 65,-15,  0),
  151.     ( 55, 25,  0),( 45, 25,  0));
  152.   planes:array[1..nofplanes,0..3] of byte=(
  153. {s} (1,2,11,12),(2,3,10,11),(3,4,9,10),(4,5,8,9),(5,6,7,8),
  154. {v} (13,14,18,19),(14,15,16,17),
  155. {e} (20,21,22,23),(23,28,31,20),(24,25,26,27),(28,29,30,31),
  156. {n} (32,33,40,41),(34,35,39,40),(35,36,37,38));
  157. {$endif}
  158.  
  159. var virscr:pointer;
  160.  
  161. procedure rotate_object;
  162. const xst=2; yst=2; zst=-3;
  163. var
  164.   xp,yp,z:array[1..nofpoints] of integer;
  165.   x,y:integer;
  166.   n,phix,phiy,phiz:byte;
  167. begin
  168.   phix:=0; phiy:=128; phiz:=0;
  169.   fillchar(xp,sizeof(xp),0);
  170.   fillchar(yp,sizeof(yp),0);
  171.   fillchar(z,sizeof(z),0);
  172.   destenation:=virscr;
  173.   repeat
  174.     vretrace;
  175.     setborder(200);
  176.     cls(virscr,320*200); { clear virtual screen }
  177.     for n:=1 to nofpoints do begin
  178.       x:=points[n,0]; y:=points[n,1]; z[n]:=points[n,2]; { get original object }
  179.       rotate(x,y,z[n],phix,phiy,phiz); { rotate it }
  180.       conv3dto2d(xp[n],yp[n],x,y,z[n]); { convert 3d points to 2d }
  181.     end;
  182.     for n:=1 to nofplanes do begin
  183.       polyz[n]:=(z[planes[n,0]]+z[planes[n,1]]+z[planes[n,2]]+z[planes[n,3]]) div 4;
  184.       pind[n]:=n;
  185.     end;
  186.     quicksort(nofplanes); { depth sort }
  187.     for n:=fpoly to nofplanes do { draw seperate planes }
  188.       polygon(xp[planes[pind[n],0]],yp[planes[pind[n],0]],
  189.               xp[planes[pind[n],1]],yp[planes[pind[n],1]],
  190.               xp[planes[pind[n],2]],yp[planes[pind[n],2]],
  191.               xp[planes[pind[n],3]],yp[planes[pind[n],3]],
  192.               160+ctab[phix] div 2,100+stab[phiy] div 4,polyz[n]+130);
  193.     inc(phix,xst); inc(phiy,yst); inc(phiz,zst); { increase angles }
  194.     setborder(0);
  195.     flip(virscr,ptr(u_vidseg,0),320*200); { display screen }
  196.   until keypressed;
  197. end;
  198.  
  199. var i,j:word;
  200. begin
  201.   setvideo($13);
  202.   {u_border:=true;}
  203.   getmem(virscr,320*200); cls(virscr,320*200);
  204.   for i:=1 to 255 do setrgb(i,i div 16,i div 8,i div 4);
  205.   rotate_object;
  206.   freemem(virscr,320*200);
  207.   setvideo(u_lm);
  208. end.
  209.